COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00004 00003	(DE SAVEUP(TAG)(SETQ CLINK (CONS(LIST EXP FUN ARGS EARGS TAG ENV)CLINK)))
C00006 ENDMK
C⊗;


(DEFPROP EVAL* 
 (LAMBDA NIL
  (COND ((IS_CONST EXP) (SETQ VAL (DENOTE EXP)) (RESTORE))
	((IS_VAR EXP) (SETQ VAL (LOOKUP EXP ENV)) (RESTORE))
	(T (SETQ FUN (FUN EXP)) (SETQ ARGS (ARGS EXP)) (SETQ PC (QUOTE EVAL1))))) 
EXPR)

(DEFPROP EVAL1 
 (LAMBDA NIL
  (COND ((IS_EXPR FUN) (SETQ PC (QUOTE EVALEXPR)))
	((IS_FEXPR FUN)
	 (COND ((PRIM_OP_FEXPR FUN) (JUMP_RESTORE_FEXPR FUN))
	       (T (SETQ EXP (BODY FN)) (SETQ ENV (NEW_ENV (VARS FN) ARGS ENV)) (SETQ PC (QUOTE EVAL*)))))
	(T (SAVEUP (QUOTE EVAL2)) (SETQ EXP FUN) (SETQ PC (QUOTE EVAL*))))) 
EXPR)

(DEFPROP EVALEXPR 
 (LAMBDA NIL
  (COND ((NULL ARGS)
	 (COND ((PRIM_OP_EXPR FUN) (JUMP_RESTORE_EXPR FUN))
	       (T (SETQ EXP (BODY FUN))
		  (SETQ ENV (NEW_ENV (VARS FUN) (SPREAD EARGS) ENV))
		  (SETQ PC (QUOTE EVAL*)))))
	(T (SAVEUP (QUOTE EVALEXPR1)) (SETQ EXP (FIRST ARGS)) (SETQ PC (QUOTE EVAL*))))) 
EXPR)

(DEFPROP EVALEXPR1 
 (LAMBDA NIL (PROG NIL (PUSH VAL EARGS) (POP ARGS) (RETURN (SETQ PC (QUOTE EVALEXPR))))) 
EXPR)

(DEFPROP EVAL2 
 (LAMBDA NIL (PROG NIL (SETQ FUN VAL) (RETURN (SETQ PC (QUOTE EVAL1))))) 
EXPR)

(DE SAVEUP(TAG)(SETQ CLINK (CONS(LIST EXP FUN ARGS EARGS TAG ENV)CLINK)))

(DE RESTORE()(PROG (Z)(SETQ Z(CAR CLINK))(SETQ CLINK(CDR CLINK))
(SETQ EXP(CAR Z))
(SETQ Z(CDR Z))(SETQ FUN(CAR Z))
(SETQ Z(CDR Z))(SETQ ARGS(CAR Z))
(SETQ Z(CDR Z))(SETQ EARGS(CAR Z))
(SETQ Z(CDR Z))(SETQ PC(CAR Z))
(SETQ Z(CDR Z))(SETQ ENV(CAR Z))
(RETURN NIL)
))

(DE LOOP()(PROG()
A(PRINT PC)
 (PC)
(PRINT VAL)
(GO A)
))

(DE IS_CONST(X)((OR(NUMBERP X)(EQ X T)(EQ X NIL)(AND (NOT(ATOM X)(EQ(CAR X) (QUOTE QUOTE)]

(DE IS_VAR(X)(ATOM X))

(DE LOOKUP(X ENV)(ASSOC X ENV))

(DE NEW_ENV(VARS VALS ENV)
	(PROG (Z ENV1)
	(SETQ Z (SETQ ENV1 ENV))
	 (COND((NULL VARS)(RETURN ENV1)))